home *** CD-ROM | disk | FTP | other *** search
- 1 REM TIMEDEMO.BAS Measure time to print 10 long strings on a screen
- 2 REM under varying conditions below
- 3 REM
- 4 REM ***** NOTE: USE SUBDEMO.BAS for examples of how to use the routines
- 5 REM Because extra convoluted logic is used here.
- 6 REM
- 10 REM Time QPRINT, PRINT under conditions below
- 20 REM Interpreted Standard PRINT
- 30 REM Interpreted PRINT with BASPRINT
- 40 REM Interpreted QPRINT with ASMBASIC
- 50 REM Compiled PRINT
- 60 REM Compiled PRINT with COMPRINT or PRSLASHO
- 70 REM Compiled QPRINT
- 80 REM Compiled CLS versus CLREOS
- 90 REM Make a random access file with time to write the screen.
- 100 REM For each time cycle, read in the RA file, and display the times for
- 110 REM each type of print, and display the number of times the screen has
- 120 REM been written.
- 130 REM Determine whether we are running compiled or interpreted
- 140 REM FLAG% = 0 if interpreted
- 144 REM FLAG% = 1 if compiled without /O (needs BASRUN.EXE)
- 145 REM FLAG% = 2 if compiled with /O
- 150 REM FLAG% = 3 if business basic compiled
- 170 REM
- 180 DIM A$(20),T$(20)
- 190 DEFINT S,I
- 200 KEY OFF
- 210 FOR I = 1 TO 10
- 220 KEY I,""
- 230 NEXT I
- 240 REM
- 250 DEF SEG
- 260 TEST$ = "K"
- 270 A% = VARPTR(TEST$)
- 280 B% = PEEK(A%+1) + 256*PEEK(A%+2)
- 290 IF CHR$(PEEK(B%)) = "K" THEN FLAG% = 0 : GOTO 360
- 300 B% = PEEK(A%+2) + 256*PEEK(A%+3)
- 310 IF CHR$(PEEK(B%)) <> "K" THEN FLAG% = 3 : GOTO 788
- 312 WIDTH 80 : IF PEEK(&H7CC) = 80 THEN FLAG% = 1 ELSE FLAG% = 2
- 320 GOTO 880
- 330 REM
- 340 REM If interpreted, check that ASMBASIC is resident below the interpreter
- 350 REM
- 360 DEF SEG = 0
- 370 A% = PEEK(&H19C) + 256*PEEK(&H19D) : B% = PEEK(&H19E) + 256*PEEK(&H19F)
- 380 DEF SEG = B%
- 390 IF (PEEK(A%-1) = &H52) AND (PEEK(A%-2) = &H52) THEN ASM%=1:GOTO 470
- 400 CLS : PRINT TAB(85);"ASMBASIC must be executed once before starting"
- 410 PRINT TAB(15);"the Basic interpreter"
- 420 ASM% = 0
- 430 GOTO 880
- 440 REM
- 450 REM If interpreted, then get the segment and offset of the utility routines
- 460 REM
- 470 DEF SEG
- 480 DIM INIT%(3) ' setup subroutine containing INT 67h
- 490 INIT%(1) = &H67CD ' RETF 2
- 500 INIT%(2) = &H2CA
- 510 INIT%(3) = 0
- 520 SUBINIT = 0
- 530 REM
- 540 REM get the code segment of the utility subroutines
- 550 SEGVALUE% = 0
- 560 SUBINIT = VARPTR(INIT%(1)): CALL SUBINIT(SEGVALUE%)
- 570 REM
- 580 REM get the offset of the utility subroutines
- 590 A% = 1
- 600 SUBINIT = VARPTR(INIT%(1)):CALL SUBINIT(A%)
- 610 QPRINT = A%
- 620 A% = 2
- 630 SUBINIT = VARPTR(INIT%(1)):CALL SUBINIT(A%)
- 640 SCRLDN = A%
- 650 A% = 3
- 660 SUBINIT = VARPTR(INIT%(1)):CALL SUBINIT(A%)
- 670 SCRLUP = A%
- 680 A% = 4
- 690 SUBINIT = VARPTR(INIT%(1)):CALL SUBINIT(A%)
- 700 XREP = A%
- 710 A% = 5
- 720 SUBINIT = VARPTR(INIT%(1)):CALL SUBINIT(A%)
- 730 YREP = A%
- 740 A% = 6
- 750 SUBINIT = VARPTR(INIT%(1)):CALL SUBINIT(A%)
- 760 CLREOL = A%
- 770 A% = 7
- 780 SUBINIT = VARPTR(INIT%(1)):CALL SUBINIT(A%)
- 790 CLREOS = A%
- 800 A% = 8
- 810 SUBINIT = VARPTR(INIT%(1)):CALL SUBINIT(A%)
- 820 ZPRINT = A%
- 830 REM
- 840 REM set the segment value for interpreted basic
- 850 REM
- 860 DEF SEG = SEGVALUE%
- 870 REM
- 880 REM define some attributes for use throughout the demo
- 890 IF FLAG% = 0 THEN GOTO 930 ELSE DEF SEG
- 900 ' check for comprint or prslasho, prslasho will be in the demo
- 910 ' if 100 lines take less than 3 seconds comprint is here
- 911 CLS ' initialize PRSLASHO or COMPRINT !!!!!!!!!!
- 920 STARTTIME$=TIME$
- 922 FOR I = 1 TO 100:
- 923 LOCATE 1,1:PRINT " TESTING IF COMPRINT OR PRSLASHO ARE PRESENT"
- 924 NEXT I
- 927 ENDTIME$ = TIME$
- 928 GOSUB 2840: IF DIFTIME# < 3! THEN BASPRINT%=1 ELSE BASPRINT% = 0
- 929 GOTO 1000
- 930 DEF SEG = 0 ' interpreted, check for basprint
- 940 B02D0% = PEEK(&H2D0):B02D1%=PEEK(&H2D1):B02D2%=PEEK(&H2D2):B02D3%=PEEK(&H2D3)
- 950 PRINT " CHECKING FOR BASPRINT 0:02D0 = ";HEX$(B02D1%);" ";HEX$(B02D0%);" ";HEX$(B02D3%);" ";HEX$(B02D2%)
- 960 IF B02D1% = 0 THEN BASPRINT% = 1 ELSE BASPRINT% = 0
- 980 DEF SEG
- 990 REM
- 1000 IF FLAG% = 0 THEN PRINT " INTERPRETED, ASMBASIC.EXE SPEEDS UP PRINTS "
- 1010 IF FLAG% = 1 THEN PRINT " COMPILED WITHOUT /O, BASRUN.EXE NEEDED, COMPRINT.EXE SPEEDS UP PRINTS"
- 1015 IF FLAG% = 2 THEN PRINT " COMPILED WITH /O, BASRUN.EXE NOT NEEDED, PRSLASHO.EXE SPEEDS UP PRINTS"
- 1020 IF FLAG% = 3 THEN PRINT " BUSINESS BASIC COMPILED "
- 1030 IF FLAG% = 0 AND ASM% = 0 THEN PRINT " ASMBASIC NOT PRESENT"
- 1040 IF FLAG% = 0 AND ASM% = 1 THEN PRINT " ASMBASIC PRESENT"
- 1050 IF FLAG% = 1 AND BASPRINT% = 0 THEN PRINT " COMPRINT IS NOT PRESENT "
- 1052 IF FLAG% = 1 AND BASPRINT% = 1 THEN PRINT " COMPRINT IS PRESENT"
- 1054 IF FLAG% = 2 AND BASPRINT% = 0 THEN PRINT " PRSLASHO IS NOT PRESENT "
- 1060 IF FLAG% = 2 AND BASPRINT% = 1 THEN PRINT " PRSLASHO IS PRESENT"
- 1070 IF FLAG% = 0 AND BASPRINT% = 0 THEN PRINT " BASPRINT NOT PRESENT"
- 1080 IF FLAG% = 0 AND BASPRINT% = 1 THEN PRINT " BASPRINT PRESENT"
- 1090 IF ASM% =1 THEN DEF SEG = SEGVALUE%
- 1095 INPUT " ENTER HOW MANY SECONDS YOU WANT THE DEMO TO LAST ";JUNK$
- 1096 IF JUNK$="" THEN SECDIV# = 1!:GOTO 1110
- 1100 NU$=""
- 1101 FOR I = 1 TO LEN(JUNK$)
- 1102 TE$ = MID$(JUNK$,I,1)
- 1103 IF INSTR("0123456789",TE$) > 0 THEN NU$=NU$+TE$ ELSE NU$="":I=LEN(JUNK$)
- 1104 NEXT I
- 1105 IF LEN(NU$) > 0 THEN SECS#=VAL(RIGHT$(NU$,8)) ELSE BEEP:GOTO 1095
- 1106 SECDIV# = SECS#/100!
- 1107 IF SECDIV# < .05 THEN SECDIV# = .05 ' keep for loop indices in bounds
- 1108 IF SECDIV# > 100! THEN SECDIV# = 100!
- 1110 CLS : LOCATE 4,4 : INPUT "Would you like the demonstration in color (Y/N)";A$
- 1120 IF A$ = "Y" OR A$ = "y" THEN 1320
- 1130 IF A$ <> "N" AND A$ <> "n" THEN 1080
- 1140 REM
- 1150 REM black and white attributes
- 1160 REM
- 1170 NORMAL% = 7 ' normal intensity white on black
- 1180 BLUE% = 7
- 1190 GREEN% = 7
- 1200 CYAN% = 7
- 1210 RED% = 7
- 1220 MAGENTA% = 7
- 1230 BROWN% = 7
- 1240 YELLOW% = 7
- 1250 WHITE% = 15 ' high intensity white on black
- 1260 LIGHTER% = 7
- 1270 BLINK% = 128
- 1280 GOTO 1570
- 1290 REM
- 1300 REM color attributes
- 1310 REM
- 1320 NORMAL% = 7 ' normal intensity white on black
- 1330 BLUE% = 1
- 1340 GREEN% = 2
- 1350 CYAN% = 3
- 1360 RED% = 4
- 1370 MAGENTA% = 5
- 1380 BROWN% = 6
- 1390 YELLOW% = 14
- 1400 WHITE% = 15 ' high intensity white on black
- 1410 REM
- 1420 REM To make a color lighter, logically OR the LIGHTER% with
- 1430 REM the color.
- 1440 REM Ex: ATTRIBUTE% = RED% OR LIGHTER%
- 1450 REM will give a light red color.
- 1460 REM
- 1470 LIGHTER% = 8
- 1480 REM
- 1490 REM To make a color blink, logically OR the BLINK% with
- 1500 REM the color.
- 1510 REM Ex: ATTRIBUTE% = RED% OR BLINK%
- 1520 REM will give a blinking red color.
- 1530 REM
- 1540 BLINK% = 128
- 1550 REM
- 1560 REM
- 1570 REM
- 1580 REM
- 1590 REM If interpreted, check that ASMBASIC is resident below the interpreter
- 1600 REM
- 1610 ' DEF SEG = 0
- 1620 ' A% = PEEK(&H19C) + 256*PEEK(&H19D) : B% = PEEK(&H19E) + 256*PEEK(&H19F)
- 1630 ' DEF SEG = B%
- 1640 ' IF (PEEK(A%-1) = &H52) AND (PEEK(A%-2) = &H52) THEN PRINT " ASMBASIC PRESENT " :ASM% = 1:ELSE PRINT " ASMBASIC NOT PRESENT ":ASM%=0
- 1650 'GOTO 1500
- 1660 ' CLS : PRINT TAB(85);"ASMBASIC must be executed once before starting"
- 1670 'REM OR comprint should be executed when testing accelerated technique
- 1680 ' PRINT TAB(15);"the Basic interpreter"
- 1690 ' SYSTEM
- 1700 REM ***************************************************************
- 1710 REM Read in or Initialize as necessary a printable file of data
- 1712 GOSUB 1950 ' initialize the timing string arrays
- 1720 OPEN "R",1,"TIMEPRIN.FIL",81
- 1730 FIELD #1, 1 AS CHECKI$, 49 AS AA$, 10 AS TT$, 21 AS SS$
- 1740 REM initialize the time per screen variable strings to spaces
- 1750 FOR I = 1 TO 10:T$(I)=SPACE$(10):NEXT I
- 1760 S$ = " Seconds per screen"
- 1770 FIELD #1, 79 AS OURNAME$, 2 AS ENDFILE$
- 1772 TEMP$= " RAYHAWK AUTOMATION, P.O. BOX 1427, BEAVERTON OR, 97075"
- 1774 LSET OURNAME$=SPACE$(79)
- 1776 LSET ENDFILE$=CHR$(13)+CHR$(10)
- 1778 PUT #1,10 ' if the file was not there before, it will be now,
- 1779 REM disk space permitting
- 1790 FOR I = 1 TO 9
- 1800 GET #1,I:IF LEFT$(A$(I),49)=AA$ THEN T$(I) = TT$:GOTO 1810
- 1802 REM uninitialized record, lets initialize it so it can be printed
- 1804 LSET CHECKI$=RIGHT$(STR$(I),1)
- 1805 LSET AA$ = A$(I)
- 1806 LSET TT$ = T$(I)
- 1807 IF I = 1 THEN LSET SS$=SPACE$(19)+CHR$(13)+CHR$(10)
- 1808 IF I > 1 THEN LSET SS$=S$+CHR$(13)+CHR$(10) ' carriage return, line feed
- 1809 PUT #1,I
- 1810 NEXT I
- 1820 ON ERROR GOTO 0
- 1830 GOSUB 1950
- 1840 REM
- 1850 IF FLAG% > 0 AND BASPRINT% = 0 THEN TINDEX%=5:GOSUB 2150 ' no comprint
- 1860 IF FLAG% > 0 AND BASPRINT% = 1 THEN TINDEX%=6:GOSUB 2150 ' comprint
- 1870 IF FLAG% = 0 AND BASPRINT% = 0 THEN TINDEX%=2:GOSUB 2150 ' no comprint
- 1880 IF FLAG% = 0 AND BASPRINT% = 1 THEN TINDEX%=3:GOSUB 2150 ' comprint
- 1890 IF FLAG% > 0 THEN GOSUB 2350 ' compiled, show off QPRINT
- 1900 IF FLAG% = 0 AND ASM% = 1 THEN GOSUB 2490 ' interpreted, ASMBASIC present
- 1901 ' show off QPRINT
- 1910 IF FLAG% > 0 THEN GOSUB 2630 'compiled, time CLS
- 1920 IF FLAG% > 0 THEN GOSUB 2710 'compiled, time CLREOS
- 1930 LOCATE 25,1:INPUT " ENTER TO STOP THE PROGRAM ";JUNK$
- 1940 SYSTEM
- 1942 REM
- 1944 REM ****************************************************************
- 1946 REM
- 1950 REM Initialize the timing arrays
- 1960 REM
- 1970 A$(1) = " Time QPRINT, PRINT under conditions below "
- 1980 A$(2) = " Interpreted Standard PRINT " + T$(2)+ S$
- 1990 A$(3) = " Interpreted PRINT with BASPRINT " + T$(3)+ S$
- 2000 A$(4) = " Interpreted QPRINT with ASMBASIC " + T$(4)+ S$
- 2010 A$(5) = " Compiled PRINT " + T$(5)+ S$
- 2020 A$(6) = " Compiled PRINT with COMPRINT or PRSLASHO " + T$(6)+ S$
- 2030 A$(7) = " Compiled QPRINT " + T$(7)+ S$
- 2040 A$(8) = " Compiled CLS " + T$(8)+ S$
- 2050 A$(9) = " Compiled CLREOS performing CLS function " + T$(9)+ S$
- 2060 RETURN
- 2070 REM
- 2080 REM print out the latest results
- 2090 GOSUB 1950
- 2100 FOR I = 0 TO 9
- 2110 LOCATE I+I+6,1:PRINT A$(I);
- 2120 NEXT I
- 2130 RETURN
- 2140 REM
- 2150 REM TEST PRINT compiled or interpreted
- 2160 IF TINDEX%=5 AND FLAG% = 1 THEN A$(0) = " Testing Compiled PRINT statements without COMPRINT "
- 2162 IF TINDEX%=6 AND FLAG% = 1 THEN A$(0) = " Testing Compiled PRINT statements with COMPRINT "
- 2164 IF TINDEX%=5 AND FLAG% = 2 THEN A$(0) = " Testing Compiled PRINT statements without PRSLASHO "
- 2166 IF TINDEX%=6 AND FLAG% = 2 THEN A$(0) = " Testing Compiled PRINT statements with PRSLASHO "
- 2180 IF TINDEX%=2 THEN A$(0) = " Testing Interpreted PRINT statements without BASPRINT "
- 2190 IF TINDEX%=3 THEN A$(0) = " Testing Interpreted PRINT statements with BASPRINT "
- 2200 ASPACE$=SPACE$(79)
- 2205 NOSCREENS = 50 * SECDIV#
- 2206 IF TINDEX% < 5 THEN NOSCREENS = 20 * SECDIV#
- 2210 STARTTIME$=TIME$
- 2240 FOR ISCREEN = 1 TO NOSCREENS
- 2250 CLS
- 2260 FOR I = 0 TO 9
- 2270 LOCATE I+I+6,1:PRINT A$(I);
- 2280 NEXT I
- 2290 ' SCNO$= " SCREEN NUMBER "+RIGHT$(" "+STR$(ISCREEN) ,5)
- 2300 ' LOCATE 20,10:PRINT SCNO$
- 2310 NEXT ISCREEN
- 2320 GOSUB 3000
- 2330 RETURN
- 2340 REM next demonstrate QPRINT --------------------------------------
- 2350 REM TEST COMPILED QPRINT
- 2360 A$(0) = " Testing Compiled QPRINT statements "
- 2365 NOSCREENS = 100 * SECDIV#
- 2370 STARTTIME$=TIME$
- 2390 FOR ISCREEN = 1 TO NOSCREENS
- 2400 CLS
- 2410 FOR I = 0 TO 9
- 2420 LOCATE I+I+6,1:CALL QPRINT (FLAG%,A$(I))
- 2430 NEXT I
- 2440 ' SCNO$= " SCREEN NUMBER "+RIGHT$(" "+STR$(ISCREEN) ,5)
- 2450 ' LOCATE 20,10:PRINT SCNO$
- 2460 NEXT ISCREEN
- 2470 TINDEX%=7:GOSUB 3000
- 2480 RETURN
- 2490 REM TEST INTERPRETED QPRINT
- 2500 A$(0) = " Testing Interpreted QPRINT statements "
- 2505 NOSCREENS = 20 * SECDIV#
- 2510 STARTTIME$=TIME$
- 2530 FOR ISCREEN = 1 TO NOSCREENS
- 2540 CLS
- 2550 FOR I = 0 TO 9
- 2560 LOCATE I+I+6,1:CALL QPRINT (FLAG%,A$(I))
- 2570 NEXT I
- 2580 ' SCNO$= " SCREEN NUMBER "+RIGHT$(" "+STR$(ISCREEN) ,5)
- 2590 ' LOCATE 20,10:PRINT SCNO$
- 2600 NEXT ISCREEN
- 2610 TINDEX%=4:GOSUB 3000
- 2620 RETURN
- 2630 ' time CLS routine
- 2632 PRINT " READY TO DO BASIC 'CLS' 500 TIMES "
- 2634 INPUT " ENTER TO CONTINUE ";JUNK$
- 2640 NOSCREENS=200 * SECDIV#
- 2650 STARTTIME$=TIME$
- 2660 FOR ISCREEN = 1 TO NOSCREENS
- 2670 CLS
- 2680 NEXT ISCREEN
- 2690 TINDEX%=8:GOSUB 3000
- 2700 RETURN
- 2710 ' time xrep routine
- 2720 ATTRIBUTE% = NORMAL%
- 2730 BLANK$=" "
- 2732 PRINT " READY TO DO STAN'S CLREOS SUBROUTINE TO CLEAR THE SCREEN 500 TIMES "
- 2734 INPUT " ENTER TO CONTINUE ";JUNK$
- 2740 COUNT%=2000
- 2750 NOSCREENS=200 * SECDIV#
- 2760 STARTTIME$=TIME$
- 2770 FOR ISCREEN = 1 TO NOSCREENS
- 2780 LOCATE 1,1:CALL CLREOS(FLAG%)
- 2790 NEXT ISCREEN
- 2800 TINDEX%=9:GOSUB 3000
- 2810 RETURN
- 2820 INPUT " ENTER TO STOP THE PROGRAM ";JUNK$
- 2830 END
- 2840 REM TIMING SUBROUTINE
- 2850 REM inputs: STARTTIME$
- 2860 REM ENDTIME$
- 2870 REM output: DIFTIME# time in seconds
- 2880 SHH#=VAL(LEFT$(STARTTIME$,2))
- 2890 EHH#=VAL(LEFT$(ENDTIME$,2))
- 2900 SSS#=VAL(RIGHT$(STARTTIME$,2))
- 2910 ESS#=VAL(RIGHT$(ENDTIME$,2))
- 2920 SMM#=VAL(MID$(STARTTIME$,4,2))
- 2930 EMM#=VAL(MID$(ENDTIME$,4,2))
- 2940 STIME#=SHH#*3600!+SMM#*60!+SSS#
- 2950 ETIME#=EHH#*3600!+EMM#*60!+ESS#
- 2960 DIFTIME#=ETIME#-STIME#
- 2970 IF DIFTIME# < 0! THEN DIFTIME#= DIFTIME# + 3600! * 24!
- 2980 RETURN
- 2990 REM
- 3000 REM compute the end time for TINDEX%
- 3010 ENDTIME$ = TIME$
- 3020 GOSUB 2840
- 3060 T$(TINDEX%) = STR$( DIFTIME# / NOSCREENS )
- 3070 T$(TINDEX%) = LEFT$(T$(TINDEX%)+SPACE$(10),10)
- 3080 ' display the end time on the screen and on the TIMEPRIN.FIL
- 3090 LSET TT$=T$(TINDEX%)
- 3100 LSET AA$=A$(TINDEX%)
- 3102 LSET CHECKI$=RIGHT$(STR$(TINDEX%),1)
- 3104 IF I = 1 THEN LSET SS$=SPACE$(19)+CHR$(13)+CHR$(10)
- 3108 IF I > 1 THEN LSET SS$=S$+CHR$(13)+CHR$(10) ' carriage return, line feed
- 3110 PUT 1,TINDEX%
- 3120 GOSUB 2080
- 3130 RETURN